home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / t / op / universal.t < prev    next >
Text File  |  1998-07-19  |  2KB  |  97 lines
  1. #!./perl
  2. #
  3. # check UNIVERSAL
  4. #
  5.  
  6. BEGIN {
  7.     chdir 't' if -d 't';
  8.     @INC = '../lib' if -d '../lib';
  9. }
  10.  
  11. print "1..72\n";
  12.  
  13. $a = {};
  14. bless $a, "Bob";
  15. print "not " unless $a->isa("Bob");
  16. print "ok 1\n";
  17.  
  18. package Human;
  19. sub eat {}
  20.  
  21. package Female;
  22. @ISA=qw(Human);
  23.  
  24. package Alice;
  25. @ISA=qw(Bob Female);
  26. sub drink {}
  27. sub new { bless {} }
  28.  
  29. $Alice::VERSION = 2.718;
  30.  
  31. package main;
  32.  
  33. my $i = 2;
  34. sub test { print "not " unless shift; print "ok $i\n"; $i++; }
  35.  
  36. $a = new Alice;
  37.  
  38. test $a->isa("Alice");
  39.  
  40. test $a->isa("Bob");
  41.  
  42. test $a->isa("Female");
  43.  
  44. test $a->isa("Human");
  45.  
  46. test ! $a->isa("Male");
  47.  
  48. test $a->can("drink");
  49.  
  50. test $a->can("eat");
  51.  
  52. test ! $a->can("sleep");
  53.  
  54. my $b = 'abc';
  55. my @refs = qw(SCALAR SCALAR     LVALUE      GLOB ARRAY HASH CODE);
  56. my @vals = (  \$b,   \3.14, \substr($b,1,1), \*b,  [],  {}, sub {} );
  57. for ($p=0; $p < @refs; $p++) {
  58.     for ($q=0; $q < @vals; $q++) {
  59.         test UNIVERSAL::isa($vals[$p], $refs[$q]) eq ($p==$q or $p+$q==1);
  60.     };
  61. };
  62.  
  63. test ! UNIVERSAL::can(23, "can");
  64.  
  65. test $a->can("VERSION");
  66.  
  67. test $a->can("can");
  68. test ! $a->can("export_tags");    # a method in Exporter
  69.  
  70. test (eval { $a->VERSION }) == 2.718;
  71.  
  72. test ! (eval { $a->VERSION(2.719) }) &&
  73.          $@ =~ /^Alice version 2.719 required--this is only version 2.718 at /;
  74.  
  75. test (eval { $a->VERSION(2.718) }) && ! $@;
  76.  
  77. my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
  78. test $subs eq "VERSION can isa";
  79.  
  80. test $a->isa("UNIVERSAL");
  81.  
  82. # now use UNIVERSAL.pm and see what changes
  83. eval "use UNIVERSAL";
  84.  
  85. test $a->isa("UNIVERSAL");
  86.  
  87. my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
  88. # XXX import being here is really a bug
  89. test $sub2 eq "VERSION can import isa";
  90.  
  91. eval 'sub UNIVERSAL::sleep {}';
  92. test $a->can("sleep");
  93.  
  94. test ! UNIVERSAL::can($b, "can");
  95.  
  96. test ! $a->can("export_tags");    # a method in Exporter
  97.